Just Call Me Internet/Just Call Me Internet.iso/prog/atari/m2/cat3src/magic/i/magicbit.i

Modula Implementation | 1997-10-26 | 6.4 KB | 205 lines

(*----------------------------------------------------------------------*
 *                                                                      *
 *         MAGIC   Modula's  All purpose  GEM  Interface  Cadre         *
 *                 ÿ         ÿ            ÿ    ÿ          ÿ             *
 *----------------------------------------------------------------------*
 * Version 3.30  02.02.1992     (C)90/91/92 by Peter Hellinger Software *
 *----------------------------------------------------------------------*
 *            Dieses Modul ist urheberrechtlich geschtzt.              *
 *                                                                      *
 * Die Ver”ffentlichung des Quelltextes oder Teilen daraus in schrift-  *
 * licher Form, insbesondere in Zeitschriften, sowie die Verbreitung    *
 * ber Public-Domain-H„ndler bedarf der ausdrcklichen schriftlichen   *
 * Genehmigung des Autors!                                              *
 *                                                                      *
 * Der Autor gibt hiermit die ausdrckliche Erlaubnis, das Modul jeder- *
 * zeit auch im Quelltext weiterzugegeben, sofern dessen Text und ins-  *
 * besondere dieser Urheberrechts-Vermerk nicht ver„ndert wird, und     *
 * durch die Weitergabe kein finanzieller Nutzen entsteht. Der Autor    *
 * beh„lt sich das Recht vor, diese Erlaubnis jederzeit u. ohne Angaben *
 * von Grnden zu widerrufen.                                           *
 *----------------------------------------------------------------------*)

IMPLEMENTATION MODULE MagicBitOps;

(*----------------------------------------------------------------------*
 * Int. Vers | Datum    | Name | Žnderung                               *
 *-----------+----------+------+----------------------------------------*
 *  3.00     | 18.01.92 |  Hp  |                                        *
 *-----------+----------+------+----------------------------------------*)



(* IMPLEMENTATION FšR  >>> Megamax-Modula-2 <<< *)
(*                                              *)
(*$R-   Range-Checks                            *)
(*$S-   Stack-Check                             *)
(*                                              *)
(*----------------------------------------------*)






FROM MagicSys   IMPORT  Nil, Null, Bit0, Bit1, Bit2, Bit3, Bit4, Bit5, Bit6,
                        Bit7, Bit8, Bit9, Bit10, Bit11, Bit12, Bit13, Bit14,
                        Bit15, LOC, Byte, ByteSet, sWORD, sINTEGER, sCARDINAL,
                        sBITSET, lINTEGER, lCARDINAL, lWORD, lBITSET,
                        CastToChar, CastToByte, CastToByteset, CastToInt,
                        CastToCard, CastToBitset, CastToWord, CastToLInt,
                        CastToLCard, CastToLBitset, CastToLWord, CastToAddr,
                        TosVersion, Accessory, Basepage, SysHeader, TosDate;






IMPORT MagicSys;
IMPORT SYSTEM;

TYPE    tByte =         POINTER TO ByteSet;
        tWord =         POINTER TO sBITSET;
        tLong =         POINTER TO lBITSET;

VAR     b1, b2, b3:     tByte;
        w1, w2, w3:     tWord;
        l1, l2, l3:     tLong;

VAR     b:              POINTER TO Byte;
        w:              POINTER TO sCARDINAL;
        l:              POINTER TO lCARDINAL;


PROCEDURE BitOp (op: Operation; c1, c2: ARRAY OF LOC; VAR val: ARRAY OF LOC);
BEGIN
 IF (HIGH (c1) = HIGH (c2)) AND (HIGH (c1) = HIGH (val)) THEN
  CASE HIGH (val) OF
   0: b1:= SYSTEM.ADR (c1);
      b2:= SYSTEM.ADR (c2);
      b3:= SYSTEM.ADR (val);
      CASE op OF
       and: b3^:= b1^ * b2^;|
       or:  b3^:= b1^ + b2^;|
       xor: b3^:= b1^ / b2^;|
      END;
      |
   1: w1:= SYSTEM.ADR (c1);
      w2:= SYSTEM.ADR (c2);
      w3:= SYSTEM.ADR (val);
      CASE op OF
       and: w3^:= w1^ * w2^;|
       or:  w3^:= w1^ + w2^;|
       xor: w3^:= w1^ / w2^;|
      END;
      |
   3: l1:= SYSTEM.ADR (c1);
      l2:= SYSTEM.ADR (c2);
      l3:= SYSTEM.ADR (val);
      CASE op OF
       and: l3^:= l1^ * l2^;|
       or:  l3^:= l1^ + l2^;|
       xor: l3^:= l1^ / l2^;|
      END;
      |
   ELSE ;
  END; (* CASE *)
 END; (* IF *)
END BitOp;

PROCEDURE SetBit (pos: sCARDINAL; VAR val: ARRAY OF LOC);
BEGIN
 CASE HIGH (val) OF
  0: b1:= SYSTEM.ADR (val);
     IF pos <  8 THEN INCL (b1^, pos);  END;
     |
  1: w1:= SYSTEM.ADR (val);
     IF pos < 16 THEN INCL (w1^, pos);  END;
     |
  3: l1:= SYSTEM.ADR (val);
     IF pos < 32 THEN INCL (l1^, pos);  END;
     |
  ELSE ;
 END; (* CASE *)
END SetBit;

PROCEDURE ClearBit (pos: sCARDINAL; VAR val: ARRAY OF LOC);
BEGIN
 CASE HIGH (val) OF
  0: b1:= SYSTEM.ADR (val);
     IF pos <  8 THEN EXCL (b1^, pos);  END;
     |
  1: w1:= SYSTEM.ADR (val);
     IF pos < 16 THEN EXCL (w1^, pos);  END;
     |
  3: l1:= SYSTEM.ADR (val);
     IF pos < 32 THEN EXCL (l1^, pos);  END;
     |
  ELSE ;
 END; (* CASE *)
END ClearBit;

PROCEDURE IsSet (pos: sCARDINAL; val: ARRAY OF LOC): BOOLEAN;
BEGIN
 CASE HIGH (val) OF
  0: b1:= SYSTEM.ADR (val);
     IF pos <  8 THEN  RETURN pos IN b1^;  END;
     |
  1: w1:= SYSTEM.ADR (val);
     IF pos < 16 THEN  RETURN pos IN w1^;  END;
     |
  3: l1:= SYSTEM.ADR (val);
     IF pos < 32 THEN  RETURN pos IN l1^;  END;
     |
  ELSE ;
 END; (* CASE *)
END IsSet;

PROCEDURE ShiftLeft  (VAR val: ARRAY OF LOC; num: sCARDINAL);
BEGIN
 CASE HIGH (val) OF
  0: b1:= SYSTEM.ADR (val);  w:= CastToAddr (b1);
     IF num <  8 THEN
      WHILE num > 0 DO  EXCL (b1^, 7);  w^:= w^ * 2;  DEC (num);  END;
     END;
     |
  1: w1:= SYSTEM.ADR (val);  w:= CastToAddr (w1);
     IF num < 16 THEN
      WHILE num > 0 DO  EXCL (w1^, 15);  w^:= w^ * 2;  DEC (num);  END;
     END;
     |
  3: l1:= SYSTEM.ADR (val);  l:= CastToAddr (l1);
     IF num < 32 THEN
      WHILE num > 0 DO  EXCL (l1^, 31);  l^:= l^ * 2;  DEC (num);  END;
     END;
     |
  ELSE ;
 END; (* CASE *)
END ShiftLeft;

PROCEDURE ShiftRight (VAR val: ARRAY OF LOC; num: sCARDINAL);
BEGIN
 CASE HIGH (val) OF
  0: w:= SYSTEM.ADR (val);
     IF num <  8 THEN
      WHILE num > 0 DO  w^:= w^ DIV 2;  DEC (num);  END;
     END;
     |
  1: w:= SYSTEM.ADR (val);
     IF num < 16 THEN
      WHILE num > 0 DO  w^:= w^ DIV 2;  DEC (num);  END;
     END;
     |
  3: l:= SYSTEM.ADR (val);
     IF num < 32 THEN
      WHILE num > 0 DO  l^:= l^ DIV 2;  DEC (num);  END;
     END;
     |
  ELSE ;
 END; (* CASE *)
END ShiftRight;

END MagicBitOps.